00100		SUBROUTINE PIC2
00200	
00300	CC	COMMON/DP/IDP(4000)
00400	CC	CALL DPYSET(1,IDP,4000)
00500	
00600		EQUIVALENCE(LIST,CURV)
00700	
00800		DIMENSION CURV(2,3000),HIST(0/63),DIF(3)
00900	
01000		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
01100		1 DEBUG,TE(1),XP(1),YP(1),PARMAX,
01200		1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
01300	
01400		COMMON /LISTC/JXX(4000),LIST(6,1000),LIST5(0/1000),NEWEND,LO
01500	
01600		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01700		1 LSIDE,RSIDE,JCNT,HYSTAB(1)
01800	
01900		INTEGER FI,FILEN,EWE,HIST,BITS,
02000		1 XIX,XI,FLINE,RSIDE,
02100		1 NUM2,NUM3,IDD,PL,LIST5,X
02200	
02300		REAL LIST,RR,CL,SL,LEAP,LEA6,LEA3,CONST,FRAC,
02400		1 RX,RY,TEXT,TH,W1,W2,B1,B2,V1,V2,
02500		1 LV,LW,LB,D1,D2,CURV,T,X1,X2,A1,A2,C1,C2,MA,LC,
02600		1 D,B,DIF,B0,BB1,C3,C4
02700		DATA JCNT/0/,RTO/6./
02800		DIF(1)=0.0
02900		B0=0.0
03000		BB1=2**BITS-1
03100		CONST=2.41
03200		IF(FLINE.EQ.0.AND.LSIDE.EQ.0.AND.
03300		1 LLINE.EQ.252.AND.RSIDE.EQ.251) CONST=CONST*.6667
03400	68	LEAP=(RR/2.+CONST)*RTO
03500		LEA6=LEAP/6.
03600		LEA3=LEAP/3.
03700		TH=(LEAP**2)*0.075
03800	
03900		DO 70 IDD=0,63
04000	70	HIST(IDD)=0
04100		FRAC=64.0/FLOAT(2**BITS)
04200		DO 100 XIX=1,NEWEND
04300		IDD=IFIX(LIST(5,XIX)*FRAC+0.5)
04400		IF(0.GT.IDD) IDD=0
04500		IF(63.LT.IDD) IDD=63
04600		HIST(IDD)=HIST(IDD)+1
04700	100	CONTINUE
04800	
04900		DO 110 IDD=1,63
05000	110	HIST(IDD)=HIST(IDD)+HIST(IDD-1)
05100		IF(HIST(63).NE.NEWEND) PAUSE 'ERROR IN PLOU'
05200		NUM2=IFIX(FLOAT(NEWEND)/3.+0.5)
05300		NUM3=IFIX(FLOAT(NEWEND)*2./3.+0.5)
05400		DO  121 IDD=1,63
05500		IF(NUM2.GE.(HIST(IDD)+HIST(IDD-1))/2) DIF(2)=FLOAT(
05600		1 IDD)/FRAC
05700	121	IF(NUM3.GE.(HIST(IDD)+HIST(IDD-1))/2) DIF(3)=FLOAT(
05800		1 IDD)/FRAC
05900	
06000		DO 123 I=0,1000
06100	123	LIST5(I)=1
06200	
06300	125	XI=1
06400		DO 120 XIX=1,NEWEND
06500		D=LIST(5,XIX)
06600		B=LIST(6,XIX)
06700		IF(((B+D.LT.B0+DIF(1)).OR.(B.GT.BB1-DIF(1)
06800		1 )).OR.(D.LT.DIF(1))) GOTO 120
06900		RX=LIST(1,XIX)*RTO
07000		RY=LIST(2,XIX)*RTO
07100		CL=LIST(3,XIX)*LEA6
07200		SL=LIST(4,XIX)*LEA6
07300		CURV(1,XI)=RX-SL
07400		CURV(2,XI)=RY+CL
07500		CURV(3,XI)=RX+SL
07600		CURV(4,XI)=RY-CL
07700		IF(((B+D.LT.B0+DIF(2)).OR.(B.GT.BB1-DIF(2)
07800		1 )).OR.(D.LT.DIF(2))) GOTO 118
07900		LIST5((XI-1)/2)=2
08000		IF(((B+D.LT.B0+DIF(3)).OR.(B.GT.BB1-DIF(3)
08100		1 )).OR.(D.LT.DIF(3))) GOTO 118
08200		LIST5((XI-1)/2)=3
08300	118	XI=XI+2
08400	120	CONTINUE
08500	
08600	CC	DO 400 PL=1,3
08610		PL=1
08700	
08800	CC	GOTO(140,130,130),PL
08900	CC130	X=1
09000	CC	DO 136 XI=1,EWE-3,2
09100	CC	I=(XI-1)/2
09200	CC	IF(LIST5(I).LT.PL) GOTO 136
09300	CC	C1=CURV(1,XI)
09400	CC	C2=CURV(2,XI)
09500	CC	C3=CURV(3,XI)
09600	CC	C4=CURV(4,XI)
09700	CC	CURV(1,X)=C1
09800	CC	CURV(2,X)=C2
09900	CC	CURV(3,X)=C3
10000	CC	CURV(4,X)=C4
10100	CC	LIST5((X-1)/2)=LIST5(I)
10200	CC	X=X+2
10300	CC136	CONTINUE
10400	CC	XI=X
10500	
10600	140	EWE=XI+1
10700		FI=1
10800		LA=0
10900		DO 135 XIX=4,EWE,2
11000		LI=XIX-2
11100	
11200		IF((2.*CURV(1,LI)-CURV(1,XIX-3)-2.*CURV(1,XIX-1)+
11300		1 CURV(1,XIX))**2+(2.*CURV(2,LI)-CURV(2,XIX-3)-
11400		1 2.*CURV(2,XIX-1)+CURV(2,XIX))**2.LT.TH) GOTO 135
11500	
11600		LA=LI
11700		KI=FI+1
11800	CC	IF(KI.EQ.LA) GOTO 200
11900	CC	IF(PL.GT.1) GOTO 200
12000	
12100	CC	CURV(1,FI)=CURV(1,FI)*1.5-CURV(1,KI)*0.5
12200	CC	CURV(2,FI)=CURV(2,FI)*1.5-CURV(2,KI)*0.5
12300	CC	CURV(1,LA)=CURV(1,LA)*1.5-CURV(1,LA-1)*0.5
12400	CC	CURV(2,LA)=CURV(2,LA)*1.5-CURV(2,LA-1)*0.5
12500	
12600	200	CALL PACK(JCNT,CURV(1,FI),CURV(2,FI),3)
12700	2002	NI=LA-2
12800		JI=FI-1
12900		DO 210 I=JI,NI
13000		KI=I+1
13100		LI=KI+1
13200		MI=LI+1
13300		B1=CURV(1,LI)-CURV(1,KI)
13400		B2=CURV(2,LI)-CURV(2,KI)
13500		IF (I.EQ.JI) GOTO 202
13600		A1=CURV(1,KI)-CURV(1,I)
13700		A2=CURV(2,KI)-CURV(2,I)
13800		GOTO 204
13900	202	A1=B1
14000		A2=B2
14100	204	IF (I.EQ.NI) GOTO 206
14200		C1=CURV(1,MI)-CURV(1,LI)
14300		C2=CURV(2,MI)-CURV(2,LI)
14400		GOTO 208
14500	206	C1=B1
14600		C2=B2
14700	208	MA=A1**2+A2**2
14800		LB=B1**2+B2**2
14900		LC=C1**2+C2**2
15000		V1=A1*LB+B1*MA
15100		V2=A2*LB+B2*MA
15200		W1=B1*LC+C1*LB
15300		W2=B2*LC+C2*LB
15400		LV=SQRT(V1**2+V2**2)
15500		LW=SQRT(W1**2+W2**2)
15600		LB=SQRT(LB)
15700	CC	IF (LV.LT.1.E-6.OR.LW.LT.1.E-6) PAUSE 'LV LW'
15800		AA=LB*.5858
15900		AB=AA/LW
16000		AA=AA/LV
16100		V1=V1*AA
16200		V2=V2*AA
16300		W1=W1*AB
16400		W2=W2*AB
16500		D1=B1-V1-W1
16600		D2=B2-V2-W2
16700	
16800		DO 220 K=1,8
16900		T=FLOAT(K)/8.
17000		T1=2.-T
17100		T2=3.-2.*T
17200	220	CALL PACK(JCNT,(CURV(1,KI)+(V1*T1+(W1+D1*T2)*T)*T+.5),
17300		1 (CURV(2,KI)+(V2*T1+(W2+D2*T2)*T)*T+.5),2)
17400	210	CONTINUE
17500	
17600	135	FI=LA+1
17700	CC	IF(PL.EQ.3)RETURN
17800	CC	JCNT=JCNT+1
17900	CC400	JXX(JCNT)=-1	
18000	C  -1 INDICATES 2ND OR 3RD RUN TO BEGIN NOW.
18100	1001 	FORMAT(A1)
18101		END
18110	
18300		SUBROUTINE PACK(J,X,Y,N)
18400		COMMON /LISTC/JXX(4000),LIST(6,1000),LIST5(0/1000),NEWEND,LO
18500	CC	COMMON/DP/IDP(4000)
18600		DATA II/10/
18700		IF(J.GE.4000)RETURN
18800		L=Y
18900		M=X
19310	4	IF(N.EQ.3)GO TO 5
19320		IX=IX+1
19330		IF(IX.LT.II)RETURN
19340		IX=0
19350	C  DISPLAYS EVERY IIth LINE
19400		IF((M.EQ.MA.AND.M.EQ.MB).OR.(L.EQ.LA.AND.L.EQ.LB))J=J-1
19500	C  TO AVOID SEVERAL POINTS ON STRAIGHT LINE
19600		MB=MA
19700		LB=LA
19800		MA=M
19900		LA=L
20000	5	K=M*100000+L
20100	3	IF(N.EQ.3)K=-K
20200	CC	IF(N.EQ.3)GO TO 8
20300	CC	IF(II.NE.J)CALL AVECT(M-380,L-200)
20400	CC	CALL DPYOUT(1)
20500	CC	GO TO 9
20600	CC8	CALL AIVECT(M-380,L-200)
20700	9	J=J+1
20800		JXX(J)=K
20900	CC	II=J
21000	CC1	FORMAT(I5,I,I5,I4)
21100		END